InfoMagic Internet Tools 1993 July

home *** CD-ROM | disk | FTP | other *** search

/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / info-service / gopher / Rice_CMS / gopher24 / gopsrv.$exec < prev next >

Wrap

Text File | 1993-01-25 | 28.1 KB | 356 lines

/* 00010000 * Name: GOPSRV EXEC 00020000 * A CMS-based Gopher Server 00030000 * Based on the original, GOPHERD EXEC, from 2.3. 00040000 * Author: Rick Troth, Rice University, Information Systems 00050000 * Date: 1992-Apr-21, Aug-07, Oct-14, Dec-11, 1993-Jan-15 00060000 */ 00070000 00080000 /* 00090000 * Copyright 1993 Richard M. Troth. This software was developed 00100000 * with resources provided by Rice University and is intended 00110000 * to serve Rice's user community. Rice has benefitted greatly 00120000 * from the free distribution of software, therefore distribution 00130000 * of unmodified copies of this material is not restricted. 00140000 * You may change your own copy as needed. Neither Rice 00150000 * University nor any of its employees or students shall be held 00160000 * liable for damages resulting from the use of this software. 00170000 */ 00180000 00190000 /* 00200000 * Calls: 00210000 * GOPSRVLS REXX -- to read files and menus 00220000 * GOPSRVRP REXX -- to resolve gopher paths 00230000 * GOPSRVMB REXX -- to build menus for the client 00240000 * 00250000 * Note: this program does *not* use RXSOCKET's translation 00260000 * option. Translation between ASCII and EBCDIC 00270000 * is determined by the type of file requested. 00280000 */ 00290000 00300000 progid = "CMS Gopher 2.4.0 server" 00310000 gopher = "Gopher" 00320000 timeout = 5 00330000 00340000 Parse Source . . . . . arg0 . 00350000 argo = arg0 || ':' 00360000 Parse Upper Arg root port . '(' . ')' . 00370000 00380000 Address "COMMAND" 00390000 00400000 'SET LANGUAGE (ADD GOP USER' 00410000 00420000 host = "localhost" /* this will be reset to the actual name of * 00430000 * this host after RXSOCKET is initialized. */00440000 00450000 stdin = 0 00460000 stdout = 1 00470000 stderr = 2 00480000 00490000 Say argo progid "starting" 00500000 00510000 logpipe = "CONSOLE" 00520000 _root = Userid() 00530000 _port = 70 00540000 'PIPE < GOPHERD CONFIG * | STEM CONFIG.' 00550000 If rc = 0 Then 00560000 Do i = 1 to config.0 00570000 If Left(config.i,1) = '*' Then Iterate 00580000 If Left(config.i,1) = '#' Then Iterate 00590000 If Index(config.i,'=') = 0 Then Iterate 00600000 Parse Var config.i var '=' val 00610000 Upper var 00620000 Select /* var */ 00630000 When Abbrev("LOGPIPE",var,3) Then logpipe = val 00640000 When Abbrev("ROOT",var,4) Then _root = val 00650000 When Abbrev("PORT",var,4) Then _port = val 00660000 Otherwise 'XMITMSG 2 VAR (ERRMSG' 00670000 End /* Select var */ 00680000 End /* Do For */ 00690000 00700000 If root = "" Then root = _root 00710000 If port = "" Then port = _port 00720000 00730000 If ^Datatype(port,'N') Then Do 00740000 /* "Gopher TCP/IP service port must be numeric." */ 00750000 'XMITMSG 126 (APPLID GOP CALLER SRV ERRMSG' 00760000 Exit 24 00770000 End /* If .. Do */ 00780000 00790000 /* 00800000 * Initialize RXSOCKET 00810000 */ 00820000 maxdesc = Socket('Initialize', gopher) 00830000 If maxdesc = "-1" Then Do 00840000 Say argo tcperror() 00850000 Exit -1 00860000 End /* If .. Do */ 00870000 Say argo "RXSOCKET Initialized for" maxdesc "descriptors" 00880000 00890000 00900000 /* 00910000 * Request the name of this host 00920000 */ 00930000 rc = Socket('GetHostName', 'HOST') 00940000 If rc = "-1" Then Do 00950000 Say argo tcperror() 00960000 Exit -1 00970000 End /* If .. Do */ 00980000 Say argo "LocalHost =" host 00990000 01000000 01010000 /* 01020000 * Request a new socket descriptor (TCP protocol) 01030000 */ 01040000 socket = Socket('Socket', 'AF_INET', 'Sock_Stream') 01050000 If socket = "-1" Then Do 01060000 Say argo tcperror() 01070000 Exit -1 01080000 End /* If .. Do */ 01090000 Say argo "Primary socket =" socket 01100000 01110000 01120000 /* 01130000 * Set this socket to non-blocking mode 01140000 */ 01150000 rc = Socket('Ioctl', socket, 'FIONBIO', 1) 01160000 If rc = "-1" Then 01170000 Say argo tcperror() 01180000 01190000 01200000 /* 01210000 * 01220000 */ 01230000 name = AF_INET || Htons(port) 01240000 01250000 rc = Socket('Bind', socket, name) 01260000 If rc = "-1" Then Do 01270000 Say argo tcperror() 01280000 Exit -1 01290000 End /* If .. Do */ 01300000 Say argo "Bound to port" port 01310000 01320000 01330000 /* 01340000 * 01350000 */ 01360000 rc = Socket('Listen', socket, maxdesc) 01370000 If rc = "-1" Then Do 01380000 Say argo tcperror() 01390000 Exit -1 01400000 End /* If .. Do */ 01410000 /* Say argo "Listening ..." */ 01420000 01430000 /* UNIX and VMS style logging: */ 01440000 Parse Value Date('S') With 1 yy 5 mm 7 dd 9 . 01450000 day = Left(Date('W'),3) 01460000 mon = Left(Date('M'),3) 01470000 time = Time() 01480000 userid = Userid() 01490000 /* "Starting gopher daemon" Userid() */ 01500000 'PIPE COMMAND XMITMSG 120 DAY MON DD TIME YY HOST USERID' , 01510000 '(APPLID GOP CALLER SRV ERRMSG |' logpipe 01520000 01530000 Say argo progid "waiting for a connection" 01540000 01550000 'GLOBALV SELECT GOPHERD PUT HOST PORT ROOT' 01560000 01570000 Do Forever 01580000 01590000 rc = FD_ZERO('readmask') /* must be reset each time */ 01600000 rc = FD_SET(socket, 'readmask') 01610000 rc = FD_SET(stdin, 'readmask') 01620000 01630000 Say "*" /* waiting */ 01640000 rc = Socket('Select', socket + 1, 'readmask', 0, 0, 0) 01650000 If rc = "-1" Then Do 01660000 Say argo tcperror() 01670000 Leave 01680000 End /* If .. Do */ 01690000 01700000 If FD_ISSET(stdin, 'readmask') = 1 Then Leave 01710000 If FD_ISSET(socket, 'readmask') ^= 1 Then Iterate 01720000 01730000 /* 01740000 * 01750000 */ 01760000 ns = Socket('Accept', socket, 'CLIENT') 01770000 If ns = "-1" Then Do 01780000 Say argo tcperror() 01790000 Leave 01800000 End /* If .. Do */ 01810000 01820000 Say argo "Accepted" ns "at" Time() "client" c2x(client) 01830000 Parse Var client . 5 r1 +1 r2 +1 r3 +1 r4 +1 . 01840000 cipa = c2d(r1) || "." || c2d(r2) || "." || , 01850000 c2d(r3) || "." || c2d(r4) 01860000 /* Say argo "Client's IP address is" cipa */ 01870000 01880000 /* UNIX and VMS style logging: */ 01890000 Parse Value Date('S') With 1 yyyy 5 mm 7 dd 9 . 01900000 day = Left(Date('W'),3) 01910000 mon = Left(Date('M'),3) 01920000 time = Time() 01930000 01940000 /* 01950000 * Loop, reading the query line from the client. 01960000 */ 01970000 path = "" 01980000 Do Forever 01990000 02000000 rc = FD_ZERO('readmask') /* must be reset each time */ 02010000 rc = FD_SET(ns, 'readmask') 02020000 02030000 rc = Socket('Select', ns + 1, 'readmask', 0, 0, timeout) 02040000 If rc = "-1" Then Do 02050000 Say argo tcperror() 02060000 Exit -1 02070000 End /* If .. Do */ 02080000 02090000 If FD_ISSET(ns, 'readmask') ^= 1 Then Leave 02100000 02110000 pack = "" 02120000 bytes_in = Socket('Read', ns, 'PACK') 02130000 If bytes_in = "-1" Then 02140000 Say argo tcperror() 02150000 If bytes_in < 1 Then Leave 02160000 If Index(pack,'0A'x) > 0 Then Leave /* ASCII LF */ 02170000 If Index(pack,'0D'x) > 0 Then Leave /* ASCII CR */ 02180000 path = path || pack 02190000 End 02200000 path = path || pack 02210000 02220000 Parse Var path path '0A'x . /* ASCII LF */ 02230000 Parse Var path path '0D'x . /* ASCII CR */ 02240000 'PIPE VAR PATH | A2E | VAR PATH' 02250000 02260000 /* refresh disk access (same procedure as used by GONE EXEC) */ 02270000 'PIPE CMS QUERY DISK | DROP | STEM STEM.' 02280000 Do i = 1 to stem.0 02290000 Parse Var stem.i . 8 va 12 fm . 02300000 If Left(va,3) = "DIR" Then Iterate 02310000 'DISKWRIT' Left(fm,1) 02320000 If rc = 1 Then 'ACCESS' va fm 02330000 End /* Do For */ 02340000 02350000 client = cipa 02360000 'GLOBALV SELECT GOPHERD PUT CLIENT' 02370000 02380000 02390000 Parse Var path path '05'x parm 02400000 Say argo "Requesting:" path 02410000 If parm ^= "" Then Say argo "+ Parms:" parm 02420000 02430000 Select /* type */ 02440000 02450000 When path = "" Then Do 02460000 type = '1' 02470000 logmsg = 121 /* "Root Connection" */ 02480000 End /* When .. Do */ 02490000 02500000 When Left(path,1) = '1' Then Do 02510000 Parse Var path 1 type 2 path 02520000 logmsg = 122 /* "retrieved directory" path */ 02530000 End /* When .. Do */ 02540000 02550000 When Left(path,1) = '7' Then Do 02560000 Parse Var path 1 type 2 path 02570000 logmsg = 125 /* "searched directory" path */ 02580000 End /* When .. Do */ 02590000 02600000 When Left(path,1) = '/' Then Do 02610000 type = '0' 02620000 logmsg = 123 /* "retrieved file" path */ 02630000 End /* When .. Do */ 02640000 02650000 Otherwise Do 02660000 Parse Var path 1 type 2 path 02670000 logmsg = 123 /* "retrieved file" path */ 02680000 End /* Otherwise Do */ 02690000 02700000 End /* Select type */ 02710000 02720000 'GLOBALV SELECT GOPHERD PUT PATH PARM' 02730000 'GLOBALV SELECT GOPHERD SET MENU' 02740000 02750000 Select /* type */ 02760000 02770000 When type = "0" Then /* plain text file */ 02780000 pipe = 'APPEND LITERAL .' || , 02790000 '| E2A | SPEC 1-* 1 x0D0A NEXT' 02800000 02810000 When type = "1" Then /* menu */ 02820000 pipe = 'GOPSRVMB | APPEND LITERAL .' || , 02830000 '| E2A | SPEC 1-* 1 x0D0A NEXT' 02840000 02850000 When type = "7" Then /* menu with search */ 02860000 pipe = 'GOPSRVYS' parm '| GOPSRVMB | APPEND LITERAL .' || , 02870000 '| E2A | SPEC 1-* 1 x0D0A NEXT' 02880000 02890000 When type = "9" | , /* binary */ 02900000 type = "4" | , /* Mac file, send as binary */ 02910000 type = "5" | , /* PC file, send as binary */ 02920000 type = "I" | , /* send pictures as binary */ 02930000 type = "s" Then /* sound, send as binary */ 02940000 pipe = 'FBLOCK 8192' /* default processing */ 02950000 02960000 When type = "p" Then /* PostScript */ 02970000 pipe = 'E2A | SPEC 1-* 1 x0D0A NEXT' 02980000 02990000 When type = "r" | , /* record oriented file */ 03000000 type = "v" Then /* var-length records */ 03010000 pipe = 'BLOCK 65531 CMS |' pipe 03020000 03030000 Otherwise /* send it as binary */ 03040000 pipe = 'FBLOCK 8192' /* default processing */ 03050000 03060000 End /* Select type */ 03070000 03080000 'PIPE GOPSRVLS' root '| GOPSRVRP' path , 03090000 '|' pipe '| FBLOCK 8192 | STEM STEM.' 03100000 03110000 /* If rc ^= 0 Then logrqest = logrqest "(rc=" || rc || ")" */ 03120000 03130000 'PIPE COMMAND XMITMSG' logmsg 'DAY MON DD TIME YY CLIENT PATH' , 03140000 '(APPLID GOP CALLER SRV ERRMSG |' logpipe 03150000 03160000 03170000 Say argo stem.0 "blocks to send" 03180000 /* 03190000 * Send the response to our client 03200000 */ 03210000 Do i = 1 to stem.0 03220000 bytes_out = Socket('Write', ns, stem.i) 03230000 If bytes_out = "-1" Then Do 03240000 Say argo tcperror() 03250000 Leave 03260000 End /* If .. Do */ 03270000 End /* Do For */ 03280000 03290000 03300000 /* 03310000 * All done, relinquish our socket descriptor 03320000 */ 03330000 rc = Socket('Close', ns) 03340000 If rc = "-1" Then Do 03350000 Say argo tcperror() 03360000 Leave 03370000 End /* If .. Do */ 03380000 Say argo "Closed" ns "at" Time() 03390000 03400000 03410000 End /* Do Forever */ 03420000 03430000 03440000 /* 03450000 * Tell RXSOCKET that we are done with this IUCV path 03460000 */ 03470000 rc = Socket('Terminate') 03480000 If rc = "-1" Then Do 03490000 Say argo tcperror() 03500000 End /* If .. Do */ 03510000 03520000 03530000 Exit 03540000 03550000